{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## A complete plotting example\n",
    "\n",
    "This example is inspired from the [plot-gtk-ui](https://github.com/sumitsahrawat/plot-gtk-ui) package. Our goal will be to create an interface to display functions."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "{-# LANGUAGE OverloadedStrings #-}\n",
    "{-# LANGUAGE FlexibleContexts #-}\n",
    "import IHaskell.Display.Widgets"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "First, we create a common structure that will hold all the information required to create a plot. This has to be done first so that we can hook widget events to modify it. The plotting logic is implemented next for the same reason."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "import Data.IORef\n",
    "import Data.Monoid (mempty)\n",
    "import Data.Text (Text)\n",
    "import qualified Data.Map as M\n",
    "import Data.Proxy\n",
    "\n",
    "data PlotInfo = PlotInfo {\n",
    "    plotTitle :: String,\n",
    "    plotTitleSize :: Double,\n",
    "    xLabel :: String,\n",
    "    xLabelSize :: Double,\n",
    "    yLabel :: String,\n",
    "    yLabelSize :: Double,\n",
    "    showXGrid :: Bool,\n",
    "    showYGrid :: Bool,\n",
    "    xRange :: (Double, Double),\n",
    "    yRange :: (Double, Double),\n",
    "    sampling :: Double,\n",
    "    functions :: M.Map String (Double -> Double)\n",
    "  }\n",
    "\n",
    "defaultPlotInfo = PlotInfo {\n",
    "    plotTitle = mempty,\n",
    "    plotTitleSize = 10,\n",
    "    xLabel = mempty,\n",
    "    xLabelSize = 10,\n",
    "    yLabel = mempty,\n",
    "    yLabelSize = 10,\n",
    "    showXGrid = True,\n",
    "    showYGrid = True,\n",
    "    xRange = (-5, 5),\n",
    "    yRange = (-5, 5),\n",
    "    sampling = 50,\n",
    "    functions = mempty\n",
    "  }"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now, we implement the plotting logic. We also create an `ImageWidget` here, which will be used to display the plot."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "import Data.IORef\n",
    "import Graphics.Rendering.Chart.Easy hiding (tan)\n",
    "import Graphics.Rendering.Chart.Backend.Cairo\n",
    "import qualified Data.ByteString as B\n",
    "import IHaskell.Display (base64)\n",
    "import Control.Applicative ((<$>))\n",
    "\n",
    "tempImgWidget <- mkImage\n",
    "\n",
    "setField @Width tempImgWidget 400\n",
    "setField @Height tempImgWidget 400\n",
    "\n",
    "plotState <- newIORef defaultPlotInfo\n",
    "\n",
    "-- Update and redraw.\n",
    "update :: (PlotInfo -> IO PlotInfo) -> IO ()\n",
    "update modifier = readIORef plotState >>= modifier >>= writeIORef plotState >> redraw\n",
    "\n",
    "redraw :: IO ()\n",
    "redraw = readIORef plotState >>= mkPlot >>= setField @BSValue tempImgWidget . JSONByteString\n",
    "\n",
    "mkDset :: PlotInfo -> [(String, [(Double, Double)])]\n",
    "mkDset info = let funcs = M.toList $ functions info\n",
    "                  (xLow, xHigh) = xRange info\n",
    "                  period = 1 / sampling info\n",
    "                  xs = [xLow, xLow + period .. xHigh]\n",
    "              in map (\\(s, f) -> (s, zip xs $ map f xs)) funcs\n",
    "\n",
    "axisSetter :: Bool -> Bool -> AxisData t -> AxisData t\n",
    "axisSetter axis grid ad =\n",
    "  ad { _axis_grid = if grid then _axis_grid ad else []\n",
    "     , _axis_visibility = if axis\n",
    "                          then AxisVisibility True True True\n",
    "                          else AxisVisibility False False False\n",
    "     }\n",
    "\n",
    "mkPlot :: PlotInfo -> IO B.ByteString\n",
    "mkPlot info = do\n",
    "  let dset = mkDset info\n",
    "      opts = def { _fo_size = (400, 400) }\n",
    "  toFile opts \".chart\" $ do\n",
    "    layout_title .= plotTitle info\n",
    "    layout_title_style . font_size .= plotTitleSize info\n",
    "    layout_x_axis . laxis_title .= xLabel info\n",
    "    layout_x_axis . laxis_title_style . font_size .= xLabelSize info\n",
    "    layout_x_axis . laxis_generate .= scaledAxis def (xRange info)\n",
    "    layout_x_axis . laxis_override .= if showXGrid info then id else axisGridHide\n",
    "    layout_y_axis . laxis_title .= yLabel info\n",
    "    layout_y_axis . laxis_title_style . font_size .= yLabelSize info\n",
    "    layout_y_axis . laxis_generate .= scaledAxis def (yRange info)\n",
    "    layout_y_axis . laxis_override .= if showYGrid info then id else axisGridHide\n",
    "\n",
    "    mapM_ (\\(s, ps) -> plot (line s [ps])) dset\n",
    "  B.readFile \".chart\""
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "All that's left now is to create an interface and hook widget events accordingly.\n",
    "\n",
    "The first required element is a box, to create a vertical division between the plotting region and the input widgets."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "divBox <- mkHBox\n",
    "\n",
    "-- Two parts: A FlexBox for the left part (plot + sliders) and an Accordion for the input elements.\n",
    "plBox <- mkVBox\n",
    "tlBox <- mkAccordion\n",
    "\n",
    "-- Add the widgets to the main dividing box.\n",
    "setField @Children divBox [ChildWidget plBox, ChildWidget tlBox]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now we fill in the plotting area with:\n",
    "\n",
    "+ A `Box` to hold the sliders.\n",
    "+ An `Image` Widget to hold the plot."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "slBox <- mkVBox\n",
    "\n",
    "-- Reusing the image widget created before\n",
    "let plImg = tempImgWidget\n",
    "\n",
    "-- Add widgets to the plotting region.\n",
    "setField @Children plBox [ChildWidget slBox, ChildWidget plImg]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now, we fill the other half with the following:\n",
    "\n",
    "+ Four `Box` widgets (title, sub-title, x-label, y-label), containing a `Text` widget for title and a `BoundedFloatText` for the font size.\n",
    "+ A `FlexBox` with two selection widgets for toggling visibility for different elements. We'll go with `ToggleButton` just for fun.\n",
    "+ Two more `FlexBox`, with `FloatText` widgets for deciding the plot range."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "-- The four FlexBox widgets.\n",
    "import Control.Monad (replicateM, forM_)\n",
    "import Data.List (zip4)\n",
    "import Text.Printf (printf)\n",
    "import Data.Text (unpack, pack)\n",
    "\n",
    "-- pl : plotTitle\n",
    "-- x : xLabel\n",
    "-- y : yLabel\n",
    "boxes <- replicateM 3 mkHBox\n",
    "texts@[plTxt,xTxt,yTxt] <- replicateM 3 mkText\n",
    "inpts@[plInp,xInp,yInp] <- replicateM 3 mkBoundedFloatText\n",
    "\n",
    "-- Adding event handlers for text widgets. This is a clumsy way to emulate first-class record fields.\n",
    "let setHandler widget field = setField @ChangeHandler widget $ update $ \\info -> do\n",
    "      newStr <- getField @StringValue widget\n",
    "      return $ field info newStr\n",
    " in do\n",
    "   setHandler plTxt $ \\struct val -> struct { plotTitle = unpack val }\n",
    "   setHandler xTxt $ \\struct val -> struct { xLabel = unpack val }\n",
    "   setHandler yTxt $ \\struct val -> struct { yLabel = unpack val }\n",
    "\n",
    "-- Adding events for the numeric input widgets.\n",
    "let setHandler widget field = setField @ChangeHandler widget $ update $ \\info -> do\n",
    "      newNum <- getField @FloatValue widget\n",
    "      return $ field info newNum\n",
    " in do\n",
    "   setHandler plInp $ \\struct val -> struct { plotTitleSize = val }\n",
    "   setHandler xInp $ \\struct val -> struct { xLabelSize = val }\n",
    "   setHandler yInp $ \\struct val -> struct { yLabelSize = val }\n",
    "\n",
    "let boxInfo = zip4 boxes texts inpts [\"plot title\", \"X-Label\", \"Y-Label\"]\n",
    "\n",
    "forM_ boxInfo $ \\(box,text,input,placeholder) -> do\n",
    "  setField @Children box [ChildWidget text, ChildWidget input]\n",
    "  setField @Placeholder text $ pack $ printf \"Enter %s here ...\" placeholder\n",
    "  setField @MinFloat input 1\n",
    "  setField @MaxFloat input 72\n",
    "  setField @FloatValue input 10"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "-- A FlexBox with ToggleButtons\n",
    "buttonBox <- mkHBox\n",
    "tButtons@[xGrid,yGrid] <- replicateM 2 mkToggleButton\n",
    "\n",
    "let tgButtonInfo = zip tButtons [\"X-Grid\", \"Y-Grid\"]\n",
    "\n",
    "let setHandler widget fieldSetter = setField @ChangeHandler widget $ update $ \\info -> do\n",
    "      newStr <- getField @BoolValue widget\n",
    "      return $ fieldSetter info newStr\n",
    " in do\n",
    "   setHandler xGrid $ \\struct val -> struct { showXGrid = val }\n",
    "   setHandler yGrid $ \\struct val -> struct { showYGrid = val }\n",
    "\n",
    "forM_ tgButtonInfo $ \\(widget, description) -> do\n",
    "  setField @Description widget description\n",
    "  setField @BoolValue widget True\n",
    "\n",
    "setField @Children buttonBox (map ChildWidget tButtons)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "import Control.Arrow (first, second)\n",
    "\n",
    "-- Finally, the ranges\n",
    "rangeBoxes <- replicateM 2 mkHBox\n",
    "fTxts@[xLow,xHigh,yLow,yHigh] <- replicateM 4 mkFloatText\n",
    "\n",
    "let rangeInfo = zip rangeBoxes [(xLow,xHigh), (yLow, yHigh)]\n",
    "\n",
    "forM_ rangeInfo $ \\(box, (lowTxt, highTxt)) -> do\n",
    "  setField @Children box (map ChildWidget [lowTxt, highTxt])\n",
    "\n",
    "let setHandler widget modifier = setField @ChangeHandler widget $ update $ \\info -> do\n",
    "      val <- getField @FloatValue widget\n",
    "      return $ modifier val info\n",
    " in do\n",
    "   setHandler xLow $ \\v p -> p { xRange = first (const v) (xRange p) }\n",
    "   setHandler xHigh $ \\v p -> p { xRange = second (const v) (xRange p) }\n",
    "   setHandler yLow $ \\v p -> p { yRange = first (const v) (yRange p) }\n",
    "   setHandler yHigh $ \\v p -> p { yRange = second (const v) (yRange p) }"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now, to finally add these widgets to the right part of the window."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "setField @Children tlBox $ map ChildWidget $ boxes ++ [buttonBox] ++ rangeBoxes"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We also need to give a title to each page in the `Accordion` widget."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "setField @Titles tlBox [\"Plot title\", \"X-Label\", \"Y-Label\", \"Grid\", \"X-range\", \"Y-range\"]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Then we sync the initial values from the `plotData` to the widgets."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "syncVal (Proxy :: Proxy v) widget fieldGetter = readIORef plotState >>= setField @v widget . fieldGetter\n",
    "\n",
    "syncVal (Proxy @StringValue) plTxt (pack . plotTitle)\n",
    "syncVal (Proxy @FloatValue) plInp plotTitleSize\n",
    "\n",
    "syncVal (Proxy @StringValue) xTxt (pack . xLabel)\n",
    "syncVal (Proxy @FloatValue) xInp xLabelSize\n",
    "syncVal (Proxy @StringValue) yTxt (pack . yLabel)\n",
    "syncVal (Proxy @FloatValue) yInp yLabelSize\n",
    "\n",
    "syncVal (Proxy @BoolValue) xGrid showXGrid\n",
    "syncVal (Proxy @BoolValue) yGrid showYGrid\n",
    "\n",
    "syncVal (Proxy @FloatValue) xLow (fst . xRange)\n",
    "syncVal (Proxy @FloatValue) xHigh (snd . xRange)\n",
    "syncVal (Proxy @FloatValue) yLow (fst . yRange)\n",
    "syncVal (Proxy @FloatValue) yHigh (snd . yRange)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now that everything is set, we also need to provide a way for the user to add or remove plots from the interface."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "addFunction :: String -> (Double -> Double) -> IO ()\n",
    "addFunction name func = update $ \\p -> return p { functions = M.insert name func $ functions p }\n",
    "\n",
    "removeFunction :: String -> IO ()\n",
    "removeFunction name = update $ \\p -> return p { functions = M.delete name $ functions p }"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "And now we display the complete interface, ready to use."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "-- Spurious update to display empty plot instead of empty image initially\n",
    "update return\n",
    "\n",
    "divBox"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now, we can use `addFunction` and `removeFunction` to add and remove functions respectively."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "addFunction \"sin\" sin"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "addFunction \"cos\" cos"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "addFunction \"x^2\" (\\x -> x * x)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": []
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "Haskell",
   "language": "haskell",
   "name": "haskell"
  },
  "language_info": {
   "codemirror_mode": "ihaskell",
   "file_extension": ".hs",
   "mimetype": "text/x-haskell",
   "name": "haskell",
   "pygments_lexer": "Haskell",
   "version": "9.8.2"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 4
}
